home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 015a / vaxutils.zip / LASER.FOR < prev    next >
Text File  |  1988-03-07  |  11KB  |  1 lines

  1. C...need to change LN03 queue name in Line 141"M"JC"M"J      PROGRAM LASER"M"JC"M"JC  Program LASER prints files to the laser printer.  It allows three modes"M"JC  of orientation...portrait, landscape, and TEKTRONIX 4014.  There are"M"JC  six different fonts available."M"JC"M"JC  Additional fonts can be added as well as options for margin widths,"M"JC  spacing, etc."M"JC"M"JC  An additional modification would incorporate CLI$ calls within the program"M"JC  and a command definition file to accept qualifiers."M"JC"M"JC  November 1987   David O. Blanchard"M"JC                  Weather Research Program"M"JC                  Boulder, Colorado   80303"M"JC"M"J      CHARACTER FILENAME*80,FILENAME1*13,FILENAME2*13,BANNER*40"M"J      CHARACTER COMMAND*160,PRINTCMD*80,PRINTFILE*80"M"J      BYTE DBL_WIDE(3),REV_ON(4),REV_OFF(4)"M"J      BYTE PORTRAIT(7),LANDSCAPE(7),TEK4014(8)"M"J      BYTE FONT1(5),FONT2(5),FONT3(5),FONT4(2),FONT5(2),FONT6(3)"M"J      BYTE TEKRSET(6),RESET(4)"M"JC"M"J      DATA BS/008/"M"J      DATA  DBL_WIDE /27,35,54/                  !<ESC>6"M"J      DATA  REV_ON   /27,91,55,109/              !<ESC>[5m"M"J      DATA  REV_OFF  /27,91,48,109/              !<ESC>[0m"M"J      DATA  PORTRAIT /27,91,63,50,48,32,74/      !<ESC>[?20 J"M"J      DATA  LANDSCAPE/27,91,63,50,49,32,74/      !<ESC>[?21 J"M"J      DATA  TEK4014  /27,91,63,51,56,104,27,12/  !<ESC>[?38h<ESC><FF>"M"J      DATA  FONT1    /27,91,49,53,109/           !<ESC>[15m"M"J      DATA  FONT2    /27,91,49,51,109/           !<ESC>[13m"M"J      DATA  FONT3    /27,91,49,42,109/           !<ESC>[14m"M"J      DATA  FONT4    /27,56/                     !<ESC>8"M"J      DATA  FONT5    /27,57/                     !<ESC>9"M"J      DATA  FONT6    /12,27,58/                  !<FF><ESC>:"M"J      DATA  TEKRSET  /27,91,63,51,56,108/        !<ESC>[?38l"M"J      DATA  RESET    /27,91,33,112/              !<ESC>[!p"M"JC"M"JC  Get the file name from the user"M"JC"M"J      WRITE(6,10)"M"J   10 FORMAT(' Enter the file name:  ',$)"M"J      READ(5,20) FILENAME"M"J   20 FORMAT(A)"M"J      CALL STR$TRIM(FILENAME,FILENAME,LEN)"M"JC"M"JC  Strip off DEV:[...] portion of file name.  Use the file name as the"M"JC  print job name"M"JC"M"J      DO 30 I=1,40"M"J        IF(FILENAME(I:I) .EQ. ']') THEN"M"J          ILEN=I+1"M"J          GO TO 35"M"J        END IF"M"J   30 CONTINUE"M"J      IF (ILEN .EQ. 0) ILEN=1"M"JC"M"J   35 BANNER=FILENAME(ILEN:LEN)"M"JC"M"JC  Print out menu options for orientation and get user's choice"M"JC"M"J   40 CALL ORIENT(IORIENT)"M"JC"M"JC  Print out the menu options for the font style and get user's choice"M"JC"M"J   50 CALL FONT(IFONT,IORIENT)"M"JC"M"JC  Open a temporary file for some escape sequences"M"JC"M"J      FILENAME1='[]TEMP001.ESC'"M"J      OPEN(UNIT=1,FILE=FILENAME1,STATUS='NEW',CARRIAGECONTROL='LIST')"M"JC"M"JC  Write an opening escape sequence based on orientation"M"JC"M"J      IF(IORIENT .EQ. 1) THEN"M"J        WRITE(1,70) PORTRAIT"M"J      ELSE IF(IORIENT .EQ. 2) THEN"M"J        WRITE(1,70) LANDSCAPE"M"J      ELSE IF(IORIENT .EQ. 3) THEN"M"J        WRITE(1,80) TEK4014"M"J      END IF"M"J"M"J   70 FORMAT(7A1)"M"J   80 FORMAT(8A1)"M"JC"M"JC  Write an escape sequence to select the laser font"M"JC"M"J      IF(IFONT .EQ. 1) THEN"M"J        WRITE(1,90) FONT1"M"J      ELSE IF(IFONT .EQ. 2) THEN"M"J        WRITE(1,90) FONT2"M"J      ELSE IF(IFONT .EQ. 3) THEN"M"J        WRITE(1,90) FONT3"M"J      ELSE IF(IFONT .EQ. 8) THEN"M"J        WRITE(1,100) FONT4"M"J      ELSE IF(IFONT .EQ. 9) THEN"M"J        WRITE(1,100) FONT5"M"J      ELSE IF(IFONT .EQ. 0) THEN"M"J        WRITE(1,105) FONT6"M"J      END IF"M"J"M"J   90 FORMAT(5A1)"M"J  100 FORMAT(2A1)"M"J  105 FORMAT(3A1)"M"JC"M"JC  Close the temporary file"M"JC"M"J      CLOSE(UNIT=1)"M"JC"M"JC  Open second temporary file for escape sequences to reset LN03 to"M"JC  initial state [RIS]"M"JC"M"J      FILENAME2='[]TEMP002.ESC'"M"J      OPEN(UNIT=2,FILE=FILENAME2,STATUS='NEW',CARRIAGECONTROL='LIST')"M"JC"M"JC  If in TEK mode, we first exit TEK mode before setting [RIS]"M"JC"M"J      IF(IFONT .EQ. 3) WRITE(2,110) TEKRSET"M"J      WRITE(2,120) RESET"M"J  110 FORMAT(6A1)"M"J  120 FORMAT(4A1)"M"JC"M"JC  Close the file"M"JC"M"J      CLOSE(UNIT=2)"M"JC"M"JC  If file is to be printed in TEK mode, we need to insert form-feeds at"M"JC  the bottom of left margin one so we do not wrap into margin two"M"JC"M"J      IF(IORIENT .EQ. 3) THEN"M"J        CALL TEKFF(FILENAME,FILENAME1,FILENAME2,BANNER,IFONT)"M"J        CALL EXIT"M"J      END IF"M"JC"M"JC  Parse the commands necessary to print the files"M"JC"M"J      CALL STR$TRIM(BANNER,BANNER,ILEN)"M"J      PRINTCMD='PRINT/QUE=TXC3:/NAME='//BANNER(:ILEN)"M"J      PRINTFILE=FILENAME1//'/DEL,'//FILENAME(:LEN)//','//FILENAME2//'/DEL'"M"JC"M"J      CALL STR$TRIM(PRINTCMD,PRINTCMD,LEN1)"M"J      CALL STR$TRIM(PRINTFILE,PRINTFILE,LEN2)"M"JC"M"J      COMMAND=PRINTCMD(:LEN1)//' '//PRINTFILE(:LEN2)"M"J      CALL LIB$SPAWN(COMMAND)"M"JC"M"J      CALL EXIT"M"J      END"M"J"M"J      SUBROUTINE TEKFF(FILENAME,FILENAME1,FILENAME2,BANNER,IFONT)"M"JC"M"JC  Routine to handle files plotted in TEK4014 mode.  Requires inserting"M"JC  <ESC><FF> at the end of the first column of text."M"JC"M"J      CHARACTER LINE_TEXT*132,PRINTCMD*80,PRINTFILE*80,COMMAND*160"M"J      CHARACTER FILENAME*80,FILENAME1*13,FILENAME2*13,FILENAME3*13"M"J      CHARACTER BANNER*40"M"J      BYTE PAGE(2)"M"J      DATA PAGE /27,12/     !<ESC><FF>"M"JC"M"JC  Check the font selection to determine how many lines per page"M"JC"M"J      IF(IFONT .EQ. 8) THEN"M"J        NLINE=32"M"J      ELSE IF(IFONT .EQ. 9) THEN"M"J        NLINE=36"M"J      ELSE IF(IFONT .EQ. 0) THEN"M"J        NLINE=55"M"J      END IF"M"JC"M"JC  Open a temporary file for the TEK version of text"M"JC  Open the original file"M"JC"M"J      FILENAME3='[]TEMP003.TEK'"M"J      OPEN(UNIT=3,FILE=FILENAME3,STATUS='NEW',CARRIAGECONTROL='LIST')"M"J      OPEN(UNIT=4,FILE=FILENAME,STATUS='OLD',READONLY,ERR=100)"M"JC"M"JC Read NLINEs of text, then write a page eject sequence"M"JC"M"J   10 DO 40 I=1,NLINE"M"J      READ(4,20,END=80) LINE_TEXT"M"J   20 FORMAT(A132)"M"J      CALL STR$TRIM(LINE_TEXT,LINE_TEXT,LEN)"M"J      IF(LEN .EQ. 0) LEN=LEN+1"M"J      WRITE(3,30) LINE_TEXT(:LEN)"M"J   30 FORMAT(A)"M"J   40 CONTINUE"M"JC"M"JC  Write a page eject sequence"M"JC"M"J      WRITE(3,50) PAGE"M"J   50 FORMAT(2A1)"M"JC"M"JC  Go and read some more"M"JC"M"J      GO TO 10"M"JC"M"JC  File is read and rewritten"M"JC"M"J   80 CLOSE(UNIT=3)"M"J      CLOSE(UNIT=4)"M"JC"M"JC  Parse the commands necessary to print the files"M"JC"M"J      CALL STR$TRIM(BANNER,BANNER,ILEN)"M"J      CALL STR$TRIM(FILENAME,FILENAME,LEN)"M"JC"M"J      PRINTCMD='PRINT/QUE=TXC3:/DEL/NAME='//BANNER(:ILEN)"M"J      PRINTFILE=FILENAME1//','//FILENAME3//','//FILENAME2"M"JC"M"J      CALL STR$TRIM(PRINTCMD,PRINTCMD,LEN1)"M"J      CALL STR$TRIM(PRINTFILE,PRINTFILE,LEN2)"M"JC"M"J      COMMAND=PRINTCMD(:LEN1)//' '//PRINTFILE(:LEN2)"M"J      CALL LIB$SPAWN(COMMAND)"M"JC"M"J      RETURN"M"JC"M"J  100 CONTINUE"M"J      WRITE(6,110) FILENAME"M"J  110 FORMAT(' Error opening file: ',A)"M"JC"M"J      RETURN"M"J      END"M"J      SUBROUTINE ORIENT(IORIENT)"M"JC"M"J      BYTE BS"M"J      CHARACTER AORIENT*1"M"J      DATA BS/008/"M"JC"M"JC"M"JC  Get the users' choice for orientation...default is 1"M"JC  Provide help if the user needs it"M"JC"M"J    5 WRITE(6,10) BS,BS"M"J   10 FORMAT(' Enter orientation...<?> for help: [P]',2A1,$)"M"J      READ(5,20) AORIENT"M"J   20 FORMAT(A1)"M"J      CALL STR$UPCASE(AORIENT,AORIENT)"M"JC"M"J      IF(AORIENT .EQ. '?') THEN"M"J        PRINT*,' Select the orientation of the printed page:'"M"J        PRINT*,'     [P]:  Portrait mode'"M"J        PRINT*,'     [L]:  Landscape mode'"M"J        PRINT*,'     [T]:  Tektronix 4014 mode'"M"J        GO TO 5"M"JC"M"J      ELSE IF(AORIENT .EQ. 'P') THEN"M"J        IORIENT = 1"M"J      ELSE IF(AORIENT .EQ. 'L') THEN"M"J        IORIENT = 2"M"J      ELSE IF(AORIENT .EQ. 'T') THEN"M"J        IORIENT = 3"M"J      ELSE IF(AORIENT .EQ. ' ') THEN"M"J        IORIENT = 1"M"J      ELSE"M"J        GO TO 5"M"J      END IF"M"JC"M"J      RETURN"M"J      END"M"J      SUBROUTINE FONT(IFONT,IORIENT)"M"JC"M"J      CHARACTER AFONT*1"M"J      BYTE BS"M"J      BYTE DBL_WIDE(3),REV_ON(4),REV_OFF(4)"M"J      DATA  DBL_WIDE /27,35,54/                  ! <ESC>6"M"J      DATA  REV_ON   /27,91,55,109/              ! <ESC>[5m"M"J      DATA  REV_OFF  /27,91,48,109/              ! <ESC>[0m"M"J      DATA BS/008/"M"JC"M"JC  Get the users choice of font...default is 2"M"JC"M"J    5 IF (IORIENT .EQ. 1) THEN"M"J        WRITE(6,10) BS,BS"M"J      ELSE IF (IORIENT .EQ. 2) THEN"M"J        WRITE(6,20) BS,BS"M"J      ELSE IF (IORIENT .EQ. 3) THEN"M"J        WRITE(6,30) BS,BS"M"J      END IF"M"JC"M"J   10 FORMAT(' Enter font...<?> for help: [2]',2A1,$)"M"J   20 FORMAT(' Enter font...<?> for help: [1]',2A1,$)"M"J   30 FORMAT(' Enter font...<?> for help: [8]',2A1,$)"M"JC"M"J      READ(5,40) AFONT"M"J   40 FORMAT(A1)"M"JC"M"J      IF(AFONT .EQ. '?') THEN"M"J      PRINT*,' Select the font style to be used:'"M"J      PRINT*,'     1  Courier  6.7 point, 13.6 pitch, 66 lines/page [P/L]'"M"J      PRINT*,'     2  Courier   10 point,   10 pitch, 48 lines/page [P/L]'"M"J      PRINT*,'     3  Elite     10 point,   12 pitch, 48 lines/page [P/L]'"M"J      PRINT*,'     8  ModGothic 14 point,  7.1 pitch, 32 lines/page [TEK]'"M"J      PRINT*,'     9  ModGothic 14 point,  7.9 pitch, 36 lines/page [TEK]'"M"J      PRINT*,'     0  Courier  6.7 point,   12 pitch, 55 lines/page [TEK]'"M"J      PRINT*,' [P/L]: available in portrait/landscape modes only'"M"J      PRINT*,' [TEK]: available in TEKTRONIX 4014 modes only'"M"J      GO TO 5"M"JC"M"J      ELSE IF(IORIENT .NE. 3 .AND. AFONT .EQ. '1') THEN"M"J        IFONT = 1"M"J      ELSE IF(IORIENT .NE. 3 .AND. AFONT .EQ. '2') THEN"M"J        IFONT = 2"M"J      ELSE IF(IORIENT .NE. 3 .AND. AFONT .EQ. '3') THEN"M"J        IFONT = 3"M"J"M"J      ELSE IF(IORIENT .EQ. 3 .AND. AFONT .EQ. '8') THEN"M"J        IFONT = 8"M"J      ELSE IF(IORIENT .EQ. 3 .AND. AFONT .EQ. '9') THEN"M"J        IFONT = 9"M"J      ELSE IF(IORIENT .EQ. 3 .AND. AFONT .EQ. '0') THEN"M"J        IFONT = 0"M"J"M"J      ELSE IF(IORIENT .EQ. 1 .AND. AFONT .EQ. ' ') THEN"M"J        IFONT=2"M"J      ELSE IF(IORIENT .EQ. 2 .AND. AFONT .EQ. ' ') THEN"M"J        IFONT=1"M"J      ELSE IF(IORIENT .EQ. 3 .AND. AFONT .EQ. ' ') THEN"M"J        IFONT=8"M"J      ELSE"M"J        GO TO 5"M"J      END IF"M"JC"M"JC  Do not let users DELETE/ENTRY on the LN03 queue if it is printing in"M"JC  TEK4014 mode, otherwise LN03 will be left in an unknown state."M"JC"M"J   50 IF(IORIENT .EQ. 3) THEN"M"J        WRITE(6,60) DBL_WIDE,REV_ON,REV_OFF"M"J   60   FORMAT(1X,3A1,10X,4A1,'WARNING',4A1)"M"J        PRINT*,' You have selected TEK mode: DO NOT abort the print cycle unless you '"M"J        PRINT*,' plan to do either a software or hardware reset of the LN03.'"M"J      END IF"M"JC"M"J      RETURN"M"J      END"M"J